home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf / GFA.Beispiel / RAUCHERTEST.LST < prev    next >
File List  |  1992-09-14  |  4KB  |  127 lines
  1. ' *********************************
  2. ' * Rauchertest 1.01              *
  3. ' * ©  4.6.1990 by Henry König    *
  4. ' * Bornheide 71, 2000 Hamburg 53 *
  5. ' *********************************
  6. init                            ! Bildschirm und Fenster öffnen
  7. rauchertest                     ! Hauptprozedur
  8. CLOSES 1                        ! Bildschirm schließen
  9. CLOSEW #1                       ! Fenster schließen
  10. END                             ! und zurück zur WB
  11. PROCEDURE rauchertest           ! die Hauptprozedur
  12.   programmkopf
  13.   PRINT AT(7,28);"Rauchertest_1.01. © 1992 by Henry König, Bornheide 71, 2 Hamburg 53"
  14.   PRINT AT(4,6);" Wie alt sind Sie: ";
  15.   INPUT x$
  16.   alter=VAL(x$)
  17.   PRINT AT(4,8);"Mit welchem Alter haben Sie das Rauchen angefangen: ";
  18.   INPUT x$
  19.   beginn=VAL(x$)
  20.   PRINT AT(4,10);"Wieviel Zigaretten rauchen Sie am Tag: ";
  21.   INPUT x$
  22.   anzahl=VAL(x$)
  23.   PRINT AT(4,12);"Was kostet Ihre Zigarettenmarke: ";
  24.   INPUT x$
  25.   preis=VAL(x$)
  26.   betrag1=(alter-beginn)*365*(anzahl/19)*preis
  27.   PRINT
  28.   PRINT " Bis jetzt haben Sie für ";
  29.   PCOLOR 5,0
  30.   PRINT USING "######.##",betrag1;
  31.   PCOLOR 1,0
  32.   PRINT " DM Zigaretten geraucht."
  33.   PRINT
  34.   betrag2=(65-alter)*365*(anzahl/19)*preis
  35.   PCOLOR 1,0
  36.   PRINT " Bis zu Ihrem 65. Lebenjahr verbrauchen Sie noch ";
  37.   PCOLOR 5,0
  38.   PRINT USING "######.##",betrag2;
  39.   PCOLOR 1,0
  40.   PRINT " DM."
  41.   PRINT
  42.   PRINT " Ihre Gesamtkosten für Zigaretten: ";
  43.   PCOLOR 5,0
  44.   PRINT USING "######.##",betrag1+betrag2;
  45.   PCOLOR 1,0
  46.   PRINT " DM"
  47.   tastendruck
  48. RETURN
  49. PROCEDURE programmkopf          ! Bildschirm löschen u. Programmnamen ausgeben
  50.   CLS
  51.   COLOR 2                       ! schwarze Box
  52.   PBOX 1,1,639,20
  53.   COLOR 0                       ! grau
  54.   PBOX 6,4,633,17
  55.   COLOR 4                       ! hellgrau
  56.   LINE 6,4,633,4
  57.   LINE 6,4,6,17
  58.   PRINT AT(2,2);SPACE$(78)
  59.   PCOLOR 5,0
  60.   PRINT AT(25,2);"Rauchertest berechnet Ihre Tabakkosten"
  61.   PCOLOR 1,0
  62.   programmfuss
  63. RETURN
  64. PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  65.   COLOR 2                       ! schwarz
  66.   PBOX 1,(27*8)-10,639,(32*8)   ! schwarze Box
  67.   COLOR 0                       ! grau
  68.   PBOX 6,(27*8)-7,633,(28*8)+4  ! graue Box
  69.   PBOX 6,(29*8)+2,633,(32*8)-4  ! 2. graue Box
  70.   COLOR 4                       ! hellgrau
  71.   BOX 7,(27*8)-7,633,(32*8)-3
  72.   LINE 7,(29*8)+2,633,(29*8)+2
  73.   LINE 16,(29*8)-6,639-16,(29*8)-6
  74.   LINE 16,(29*8)+5,639-16,(29*8)+5
  75.   LINE 639-16,(29*8)-6,639-16,(26*8)+4  ! senkrechter Strich
  76.   LINE 16,(29*8)+5,16,(31*8)+2  ! senkrechter Strich
  77.   COLOR 2                       ! schwarz
  78.   LINE 7,(32*8)-3,633,(32*8)-3  ! schwarze Linie
  79.   LINE 633,(27*8)-7,633,(32*8)-3
  80.   LINE 16,(27*8)-4,639-16,(27*8)-4
  81.   LINE 16,(31*8)+2,639-16,(31*8)+2
  82.   LINE 16,(29*8)-6,16,(26*8)+4  ! senkrechter Strich
  83.   LINE 639-16,(29*8)+5,639-16,(31*8)+2    ! senkrechter Strich
  84. RETURN
  85. PROCEDURE init                  ! Bildschirm öffnen
  86.   breite%=640                   ! Screenbreite
  87.   hoehe%=256                    ! Screenhöhe
  88.   ebenen%=3                     ! 3 Bitplanes
  89.   OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
  90.   OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  91.   farben.setzen                 ! Farbpalette setzen
  92. RETURN
  93. PROCEDURE farben.setzen         ! Farben für Bildschirm
  94.   SETCOLOR 0,5,5,5              ! grau statt blau
  95.   SETCOLOR 1,15,15,15           ! weiß bleibt
  96.   SETCOLOR 2,0,0,0              ! schwarz erhalten
  97.   SETCOLOR 3,15,5,0             ! rot bleibt
  98.   SETCOLOR 4,10,10,10           ! hellgrau inverse Farbe im Filerequester
  99.   SETCOLOR 5,15,15,0            ! gelb
  100.   SETCOLOR 6,0,0,0              ! schwarz = Inverse Farbe im Filerequester
  101. RETURN
  102. PROCEDURE taste                 ! ein Zeichen von der Tastatur holen
  103.   CLR x%                        ! Steuerzeichen löschen
  104.   CLR mausk%
  105.   CLR mausx%                    ! Mausspalte löschen
  106.   CLR mausy%                    ! Mauszeile löschen
  107.   WHILE x%=0 AND MOUSEK=0
  108.     x$=INKEY$                   ! Zeichen von Tastatur
  109.     x%=ASC(x$)                  ! ASCII-Wert für Auswertung
  110.   WEND
  111.   IF MOUSEK<>0 THEN             ! linke Maustaste
  112.     mausx%=INT(MOUSEX/8)+1      ! ja, dann Spalte = mausx
  113.     mausy%=INT(MOUSEY/8)+1      ! Zeile = mausy
  114.     mausk%=MOUSEK               ! Maustaste
  115.   ENDIF
  116. RETURN
  117. PROCEDURE tastendruck
  118.   PRINT AT(4,28);SPACE$(74);
  119.   PCOLOR 5,0
  120.   PRINT AT(18,28);" Weiter mit beliebiger Taste oder Mausklick."
  121.   GOSUB taste
  122.   PCOLOR 1,0
  123.   PRINT AT(4,28);SPACE$(74)
  124. RETURN
  125. REM                               ! damit beim Kopieren der Interpreter nicht
  126. REM                               ! abstürzt
  127.